home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 March - Disc 1 / Macworld (1999-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Packages / compare.tcl next >
Encoding:
Text File  |  1998-04-05  |  4.0 KB  |  142 lines  |  [TEXT/ALFA]
  1. #========================(install)==========================================
  2. # Compare Windows.
  3. # 
  4. # Simplified (and improved) version of David C. Black's 'compare-windows'.
  5. # Modified by Mark Nagata, 2/23/93, corrected, 2/24/93.
  6. # Sped-up version, 2/25/93.
  7. #
  8. # The return position bug in David's routine (when $patt != "") 
  9. # is fixed in this version.
  10. # 
  11. # Vince renamed a couple of things and added the 'package' stuff so
  12. # this works smoothly with the new Alpha Tcl scheme.  The bindings
  13. # can now be adjusted via a preferences dialog.  Also rewrote a few
  14. # bits to try to avoid window-toggling.
  15. #===========================================================================
  16.  
  17. alpha::extension compareWindows 0.23 {
  18.     namespace eval compare {}
  19.     menu::insert Utils submenu 0 compare
  20.     menu::insert "compare" items end windowsInPlace
  21.     hook::register requireOpenWindowsHook [list compare windowsInPlace] 2
  22.     newPref binding findDifference "/`«X»" compareWindows "" compare::windowsInPlace
  23.     newPref binding findDifferenceIgnoringSpace "/1«X»" compareWindows "" compareOpt
  24.     newPref binding findNextDifference "<U/`«X»" compareWindows "" compareNext
  25.     newPref binding findNextDifferenceIgnoringSpace "<U/1«X»" compareWindows "" compareOptNext
  26.     package::addPrefsDialog compareWindows
  27. }
  28. ####
  29. # On my Extended Keyboard (where the backquote key is to the left of the 
  30. # "1" key), I Bind prefix-(shift)-backquote to 'compare(Next)' and
  31. # prefix-(shift)-1 to 'compareOpt(Next)', as in the above.
  32. # 
  33. # On my Powerbook keyboard (where nothing is to the left of the "1" key),
  34. # I Bind prefix-(shift)-1 to 'compare(Next)' and
  35. # prefix-(shift)-2 to 'compareOpt(Next)', respectively.
  36. ####
  37.  
  38. proc compareOpt {} {
  39.     compare::windowsInPlace {-w}
  40. }
  41.  
  42. proc compare::windowsInPlace {args} {
  43.     set patt {}
  44.     if {$args == "-w"} {
  45.     set patt "\[ \t\n\r\]+"
  46.     }
  47.     
  48.     set files [winNames -f]
  49.     if {[llength $files] < 2} {
  50.     alertnote "If you want to Compare texts, you need two windows."
  51.     return
  52.     }
  53.     
  54.     watchCursor
  55.     for {set i 1} {$i < 3} {incr i} {
  56.     set wn($i) [lindex $files [expr $i -1]]
  57.     set wp($i) [getPos -w $wn($i)]
  58.     select -w $wn($i) $wp($i) $wp($i)
  59.     set wrt($i) [getText -w $wn($i) $wp($i) [maxPos -w $wn($i)]]
  60.     set wt($i) $wrt($i)
  61.     if {$patt != ""} {
  62.         regsub -all $patt $wt($i) " " wt($i)
  63.     }
  64.     }
  65.     
  66.     # Exactly equal
  67.     if {$wt(1) == $wt(2)} {
  68.     alertnote "The windows match from cursors to ends."
  69.     return
  70.     }
  71.     
  72.     # Only consider smaller of two strings
  73.     set siz [string length $wt(1)]
  74.     if {$siz > [string length $wt(2)]} {
  75.     set siz [string length $wt(2)]
  76.     }
  77.     
  78.     # Equal except for added stuff
  79.     set l [expr $siz-1]
  80.     if {[string range $wt(1) 0 $l] == [string range $wt(2) 0 $l]} {
  81.     set beg $siz
  82.     set offset(1) $beg
  83.     set offset(2) $beg
  84.     } else {
  85.     set beg 0
  86.     
  87.     while {$siz} {
  88.         set siz [expr $siz/ 2]
  89.         set end [expr $beg+$siz]
  90.         if {[string range $wt(1) $beg $end] == [string range $wt(2) $beg $end]} {
  91.         incr beg $siz
  92.         incr beg
  93.         }
  94.     }
  95.     set offset(1) $beg
  96.     set offset(2) $beg
  97.     }
  98.     for {set i 2} {$i > 0} {incr i -1} {
  99.     set count $offset($i)
  100.     set pos [pos::math $wp($i) + $count]
  101.     if {$patt != ""} {
  102.         set ans [string range $wt($i) 0 [expr $offset($i)-1]]
  103.         set lans [string length $ans]
  104.         set tt [string range $wrt($i) 0 [expr $count-1]]
  105.         regsub -all $patt $tt " " tt
  106.         set ltt [string length $tt]
  107.         while {$ltt < $lans} {
  108.         incr count [expr $lans-$ltt]
  109.         set pos [pos::math $pos + [expr $lans-$ltt]]
  110.         message $pos
  111.         set tt [string range $wrt($i) 0 [expr $count-1]]
  112.         regsub -all $patt $tt " " tt
  113.         set ltt [string length $tt]
  114.         }
  115.     }
  116.     
  117.     set pos [expr [pos::compare $pos > [maxPos -w $wn($i)]] ? [maxPos -w $wn($i)] : $pos]
  118.     display -w $wn($i) [pos::math $pos - 1]
  119.     select -w $wn($i) $pos [pos::math $pos + 1]
  120.     refresh $wn($i)
  121.     }
  122.     message "difference found"
  123.     return
  124. }
  125.  
  126. proc compareNext {} {
  127.     endOfLine
  128.     catch {bringToFront [lindex [winNames -f] 1]}
  129.     endOfLine
  130.     compare::windowsInPlace
  131. }
  132.  
  133. proc compareOptNext {} {
  134.     endOfLine
  135.     catch {bringToFront [lindex [winNames -f] 1]}
  136.     endOfLine
  137.     compareOpt
  138. }
  139.  
  140.  
  141.  
  142.